home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #2 / Ham Radio 2000 - Volume 2.iso / HAMV2 / MISC / HCAL-27 / MAXUF.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1997-03-25  |  6.0 KB  |  249 lines
  1. 10  'MAXUF - Maximum Usable Frequencies - 25 MAR 97 rev.
  2. 20  CLS:KEY OFF
  3. 30  IF EX$=""THEN EX$="EXIT"
  4. 40  COLOR 7,0,1
  5. 50  PI=3.14159
  6. 60  DEF FNAC(X)=-ATN(X/SQR(-X^2+1))+PI/2     'arccos
  7. 70  DIM M$(37),A$(4),M(12)
  8. 80  DATA 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31
  9. 90  FOR X=1 TO 12
  10. 100  READ M(X)
  11. 110  NEXT X
  12. 120  M$="JANFEBMARAPRMAYJUNJULAUGSPTOCTNOVDEC
  13. 130  R0=PI/180
  14. 140  P1=2*PI
  15. 150  R1=180/PI
  16. 160  P0=PI/2
  17. 170  '
  18. 180  '.....start
  19. 190  CLS:COLOR 15,2
  20. 200  PRINT " MAXIMUM USABLE FREQUENCIES"TAB(57);"by George Murphy VE3ERP ";
  21. 210  COLOR 1,0:PRINT STRING$(80,"<0xDF!>");
  22. 220  COLOR 7,0
  23. 230  IF L1=0 THEN 280
  24. 240  LOCATE 4:PRINT " Want another AWAY QTH?  (y/n) "
  25. 250  Q$=INKEY$:IF Q$="y"THEN LOCATE CSRLIN-1:WT=-WT:GOTO 390
  26. 260  IF Q$="n"THEN L1=0:GOTO 180
  27. 270  GOTO 250
  28. 280  GOSUB 2000  'preface
  29. 290  PRINT
  30. 300  LOCATE ,24:COLOR 0,7:PRINT " Press 1 to continue or 0 to quit ":COLOR 7,0
  31. 310  Z$=INKEY$:IF Z$=""THEN 310
  32. 320  IF Z$="0"THEN CLS:RUN EX$
  33. 330  IF Z$="1"THEN 360
  34. 340  GOTO 310
  35. 350  '
  36. 360  VIEW PRINT 3 TO 24:CLS:VIEW PRINT:LOCATE 4
  37. 370  INPUT " ENTER: HOME QTH: Latitude  (+<UNK! {00F8}> if North, -<UNK! {00F8}> if South) ";LT
  38. 380  INPUT "                  Longitude (+<UNK! {00F8}> if East, -<UNK! {00F8}> if West)   ";WT
  39. 390  L1=LT:WT=-WT:W1=WT
  40. 400  IF LT<0 THEN L1$="S"ELSE L1$="N"
  41. 410  IF WT<0 THEN W1$="E"ELSE W1$="W"
  42. 420  PRINT
  43. 430  INPUT " ENTER: AWAY QTH: Latitude  (+<UNK! {00F8}> if North, -<UNK! {00F8}> if South) ";LR
  44. 440  INPUT "                  Longitude (+<UNK! {00F8}> if East, -<UNK! {00F8}> if West)   ";WR
  45. 450  L2=LR:WR=-WR:W2=WR
  46. 460  IF LR<0 THEN L2$="S"ELSE L2$="N"
  47. 470  IF WR<0 THEN W2$="E"ELSE W2$="W"
  48. 480  IF Q$="y"THEN 590
  49. 490  PRINT
  50. 500  INPUT " ENTER: DATE:     Day number..........";D6
  51. 510  INPUT "                  Month number........";M0
  52. 520  PRINT
  53. 530  INPUT " ENTER: Solar Flux number.............";SF
  54. 540  IF SF<150 THEN S9=(SF-63)*1.25 ELSE S9=SF-44
  55. 550  IF S9>0 THEN 590
  56. 560  BEEP:PRINT"          INVALID SUNSPOT NUMBER. "
  57. 570  GOTO 530
  58. 580  '
  59. 590  VIEW PRINT 4 TO 24:CLS:VIEW PRINT:LOCATE 5
  60. 600  A$=MID$(M$,3*M0-2,3)
  61. 610  X1$="DATE:   \ \ ##"+SPACE$(29)+"From: ###.#<UNK! {00F8}>!  ####.#<UNK! {00F8}>!"
  62. 620  X2$="FLUX:      ###"+SPACE$(29)+"To:   ###.#<UNK! {00F8}>!  ####.#<UNK! {00F8}>!"
  63. 630  X3$="   HOUR     MUF     "
  64. 640  X4$="##.#"
  65. 650  X5$="   OPEN "
  66. 660  LOCATE 4,23
  67. 670  COLOR 0,7:PRINT " MAXIMUM USABLE FREQUENCIES (MHz) ":COLOR 7,0
  68. 680  PRINT
  69. 690  PRINT TAB(7)USING X1$;A$,D6,ABS(L1),L1$,ABS(W1),W1$
  70. 700  PRINT TAB(7)USING X2$;SF,ABS(L2),L2$,ABS(W2),W2$
  71. 710  GOSUB 1930
  72. 720  PRINT TAB(7)"DISTANCE:";USING "###,###";DX*1.60937;
  73. 730  PRINT " km (";USING "##,###";DX;
  74. 740  PRINT " mi.)";SPC(11);"BEARING:";USING"####<UNK! {00F8}>";BH
  75. 750  IF DX>250 AND DX<6000 THEN 770
  76. 760  PRINT" WARNING - ACCURACY IS GREATEST BETWEEN 400 AND 9,600 km."
  77. 770  PRINT 
  78. 780  FOR X=1 TO 4
  79. 790  PRINT X3$;
  80. 800  NEXT X
  81. 810  PRINT 
  82. 820  L1=L1*R0
  83. 830  W1=W1*R0
  84. 840  L2=L2*R0
  85. 850  W2=W2*R0
  86. 860  FOR Y=0 TO 5
  87. 870  FOR X=0 TO 18 STEP 6
  88. 880  PRINT "   ";
  89. 890  T5=Y+X
  90. 900  T5$=STR$(T5):T5$=RIGHT$(T5$,LEN(T5$)-1)
  91. 910  IF LEN(T5$)<2 THEN T5$="0"+T5$:GOTO 910
  92. 920  T5$=T5$+"00"
  93. 930  GOSUB 1000
  94. 940  PRINT T5$;SPC(4)USING X4$;J9;
  95. 950  IF X<18 THEN PRINT X5$;ELSE PRINT ""
  96. 960  NEXT X:
  97. 970  NEXT Y
  98. 980  GOTO 2320  'end
  99. 990  '
  100. 1000  '.....calculation
  101. 1010  K7=SIN(L1)*SIN(L2)+COS(L1)*COS(L2)*COS(W2-W1)
  102. 1020  IF K7=>-0.999999 THEN 1050
  103. 1030  K7=-0.999999
  104. 1040  GOTO 1070
  105. 1050  IF K7<=0.999999 THEN 1070
  106. 1060  K7=0.999999
  107. 1070  G1=FNAC(K7)
  108. 1080  K6=1.59*G1
  109. 1090  IF K6>=1 THEN 1110
  110. 1100  K6=1
  111. 1110  K5=1/K6
  112. 1120  J9=100
  113. 1130  FOR K1=1/(2*K6) TO 1-1/(2*K6) STEP 0.9999-1/K6
  114. 1140  IF K5=1 THEN 1160
  115. 1150  K5=0.5
  116. 1160  P=SIN(L2)
  117. 1170  Q=COS(L2)
  118. 1180  A=(SIN(L1)-P*COS(G1))/(Q*SIN(G1))
  119. 1190  B=G1*K1
  120. 1200  C=P*COS(B)+Q*SIN(B)*A
  121. 1210  D=(COS(B)-C*P)/(Q*SQR(1-C^2))
  122. 1220  IF D=>-0.999999 THEN 1250
  123. 1230  D=-0.999999
  124. 1240  GOTO 1270
  125. 1250  IF D<=0.999999 THEN 1270
  126. 1260  D=0.999999
  127. 1270  D=FNAC(D)
  128. 1280  W0=W2+SGN(SIN(W1-W2))*D
  129. 1290  IF W0=>0 THEN 1310
  130. 1300  W0=W0+P1
  131. 1310  IF W0<P1 THEN 1330
  132. 1320  W0=W0-P1
  133. 1330  IF C=>-0.999999 THEN 1360
  134. 1340  C=-0.999999
  135. 1350  GOTO 1380
  136. 1360  IF C<=0.999999 THEN 1380
  137. 1370  C=0.999999
  138. 1380  L0=P0-FNAC(C)
  139. 1390  Y1=0.0172*(10+(M0-1)*30.4+D6)
  140. 1400  Y2=0.409*COS(Y1)
  141. 1410  K8=3.82*W0+12+0.13*(SIN(Y1)+1.2*SIN(2*Y1))
  142. 1420  K8=K8-12*(1+SGN(K8-24))*SGN(ABS(K8-24))
  143. 1430  IF COS(L0+Y2)>-0.26 THEN 1520
  144. 1440  K9=0
  145. 1450  G0=0
  146. 1460  M9=2.5*G1*K5
  147. 1470  IF M9<=P0 THEN 1490
  148. 1480  M9=P0
  149. 1490  M9=SIN(M9)
  150. 1500  M9=1+2.5*M9*SQR(M9)
  151. 1510  GOTO 1770
  152. 1520  K9=(-0.26+SIN(Y2)*SIN(L0))/(COS(Y2)*COS(L0)+0.000999999)
  153. 1530  K9=12-ATN(K9/SQR(ABS(1-K9*K9)))*7.63944
  154. 1540  T=K8-K9/2+12*(1-SGN(K8-K9/2))*SGN(ABS(K8-K9/2))
  155. 1550  T4=K8+K9/2-12*(1+SGN(K8+K9/2-24))*SGN(ABS(K8+K9/2-24))
  156. 1560  C0=ABS(COS(L0+Y2))
  157. 1570  T9=9.7*C0^9.6
  158. 1580  IF T9>0.1 THEN 1600
  159. 1590  T9=0.1
  160. 1600  M9=2.5*G1*K5
  161. 1610  IF M9<=P0 THEN 1630
  162. 1620  M9=P0
  163. 1630  M9=SIN(M9)
  164. 1640  M9=1+2.5*M9*SQR(M9)
  165. 1650  IF T4<T THEN 1680
  166. 1660  IF (T5-T)*(T4-T5)>0 THEN 1690
  167. 1670  GOTO 1820
  168. 1680  IF (T5-T4)*(T-T5)>0 THEN 1820
  169. 1690  T6=T5+12*(1+SGN(T-T5))*SGN(ABS(T-T5))
  170. 1700  G9=PI*(T6-T)/K9
  171. 1710  G8=PI*T9/K9
  172. 1720  U=(T-T6)/T9
  173. 1730  G0=C0*(SIN(G9)+G8*(EXP(U)-COS(G9)))/(1+G8*G8)
  174. 1740  G7=C0*(G8*(EXP(-K9/T9)+1))*EXP((K9-24)/2)/(1+G8*G8)
  175. 1750  IF G0=>G7 THEN 1770
  176. 1760  G0=G7
  177. 1770  G2=(1+S9/250)*M9*SQR(6+58*SQR(G0))
  178. 1780  G2=G2*(1-0.1*EXP((K9-24)/3))
  179. 1790  G2=G2*(1+(1-SGN(L1)*SGN(L2))*0.1)
  180. 1800  G2=G2*(1-0.1*(1+SGN(ABS(SIN(L0))-COS(L0))))
  181. 1810  GOTO 1880
  182. 1820  T6=T5+12*(1+SGN(T4-T5))*SGN(ABS(T4-T5))
  183. 1830  G8=PI*T9/K9
  184. 1840  U=(T4-T6)/2
  185. 1850  U1=-K9/T9
  186. 1860  G0=C0*(G8*(EXP(U1)+1))*EXP(U)/(1+G8*G8)
  187. 1870  GOTO 1770
  188. 1880  IF G2>J9 THEN 1900
  189. 1890  J9=G2
  190. 1900  NEXT K1
  191. 1910  RETURN
  192. 1920  '
  193. 1930  '.....distance & bearing
  194. 1940  DW=FNAC(SIN(LT*R0)*SIN(LR*R0)+COS(LT*R0)*COS(LR*R0)*COS(ABS(WT-WR)*R0))
  195. 1950  DX=DW*60*1.1508*180/PI
  196. 1960  H=FNAC((SIN(LR*R0)-SIN(LT*R0)*COS(DW))/(SIN(DW)*COS(LT*R0)))
  197. 1970  IF SIN(WR*R0-WT*R0)<0 THEN BH=H/R0 ELSE BH=360-H/R0
  198. 1980  RETURN
  199. 1990  '
  200. 2000  '.....preface
  201. 2010  TB=8
  202. 2020  PRINT TAB(TB);
  203. 2030  PRINT "This program is an edited version of MINIMUF 3.5, from QST,"
  204. 2040  PRINT TAB(TB);
  205. 2050  PRINT "December 1982, pp.36-38"
  206. 2060  PRINT
  207. 2070  PRINT TAB(TB);
  208. 2080  PRINT "The program computes maximum usable frequency by hour, given two"
  209. 2090  PRINT TAB(TB);
  210. 2100  PRINT "end points of the path, date, and solar flux.
  211. 2110  PRINT
  212. 2120  PRINT TAB(TB);
  213. 2130  PRINT "Solar flux number for the day is transmitted by WWV at 18 minutes"
  214. 2140  PRINT TAB(TB);
  215. 2150  PRINT "after the hour."
  216. 2160  PRINT
  217. 2170  PRINT TAB(TB);
  218. 2180  PRINT "Times displayed in this program are Local Standard Times."
  219. 2190  PRINT
  220. 2200  PRINT TAB(TB);
  221. 2210  PRINT "The program asks you to enter the latitude and longitude of your"
  222. 2220  PRINT TAB(TB);
  223. 2230  PRINT "home QTH, and of the DX location at the other end of the path."
  224. 2240  PRINT TAB(TB);
  225. 2250  PRINT "The DX latitude and longitude can be found by HAMCALC in either"
  226. 2260  PRINT TAB(TB);
  227. 2270  PRINT "the Latitude/Longitude Data Base program, or the Grid Square"
  228. 2280  PRINT TAB(TB);
  229. 2290  PRINT "Locator program."
  230. 2300  RETURN
  231. 2310  '
  232. 2320  '.....end
  233. 2330  GOSUB 2360:GOTO 180
  234. 2340  END
  235. 2350  '
  236. 2360  'HARDCOPY
  237. 2370  GOSUB 2480:LOCATE 25,2:COLOR 14,6
  238. 2380  PRINT " Press 1 to print screen, 2 to print screen & ";
  239. 2390  PRINT "advance paper, or 3 to continue.";:COLOR 7,0
  240. 2400  Z$=INKEY$:IF Z$="3"THEN GOSUB 2480:RETURN
  241. 2410  IF Z$="1"OR Z$="2"THEN GOSUB 2480:GOTO 2430
  242. 2420  GOTO 2400
  243. 2430  FOR QX=1 TO 24:FOR QY=1 TO 80
  244. 2440  LPRINT CHR$(SCREEN(QX,QY));
  245. 2450  NEXT QY:NEXT QX
  246. 2460  IF Z$="2"THEN LPRINT CHR$(12)
  247. 2470  GOTO 2370
  248. 2480  LOCATE 25,1:PRINT STRING$(80,32);:RETURN
  249.